#!/usr/bin/env perl
#
#	Perform crazy, brute-force audit of the darwinbuild environment to build
#	a list of available packages and their dependencies.
#
#	Stuart Crook, 20/3/09
#

#
#	Usage
#
sub usage {
	print "dbaudit: Audit a darwinbuild environment for dependencies and existing roots\n";
	print "  dbaudit [ -p package_name | -f package_list_file ] [ -o output_dir ]\n";
	print "    * package_name       Name of a single package to examine\n";
	print "    * package_list_file  File containing one package name per line\n";
	print "    * output_dir         Directory to write files to, defaults to /tmp/dbaudit/\n";
}

#
#	Read a list of package names from a file into @packages
#
sub readlist {
	#print "Supposed to read a list from $_[0] here.\n";
	my $line;
	if(-e $_[0]) {
		open(LST, $_[0]);
		while($line = <LST>) {
			chomp($line);			
			push(packages, $line);
		}
		close(LST);
		return 1;
	} else {
		print "Error: Couldn't open package list $_[0]\n";
	}
	return 0;
}

#
#	Read the darwinbuild receipt file and return its contents as an array
#
sub readreceipt {
	my $line, @lines;
	@lines = ();
	open(REC, $_[0]);
	while($line = <REC>) {
		if($line =~ / \.(\S+)$/) {
			if((-x $1) && !(-d $1)) {
				push(lines, $1);
			}
		}
	}
	close(REC);
	return @lines;
}

#
#	Examine an executable text file to find which script runs it. This assumes
#	that the project providing the script interpreter is named the same as the
#	interpreter command itself
#
sub hashbang {
	my $line, $return;
	open(SCR, $_[0]);
	if(($line = <SCR>) =~ /^#!/) {
		#print "script first line is '$line'\n";
		$line =~ m|[/ ](\w+)[ -\w+]*$|;
		#print "script language is $1\n";
		$return = $1;
	}
	close(SRC);
	return $return;
}

#
#	Perform "otool -L" on the given file, returning its results as an array
#
sub otool {
	#print "otool -L $_[0]\n";
	my @temp, @ls, $line;
	@ls = ();
	my $result = `otool -L $_[0]`;
	if($result ne '') {
		@temp = split($/, $result);
		shift(temp);
		foreach $line (@temp) {
			if( $line =~ /^\s+(\S+)\s+/ ) {
				#print "adding $1\n";
				push(ls, $1);
			}
		}		
	}
	#print "libs for $_[0] are @ls\n";
	return @ls;
}

#
#	Is a given library file $_[0] listed among the local @files list?
#
sub localdep {
	my $file;
	foreach $file (@files) { 
		#print "comparing $file and $lib\n";
		if($file eq $_[0]) {
			return 1;
		}
	}
	return 0;
}

#
#	Add a value ($_[0]) to the global @deps, if it's not already there
#
sub add2deps {
	my $item;
	foreach $item (@deps) {
		if($item eq $_[0]) { return; }
	}
	push(deps,$_[0]);
}

#
#	Add a value ($_[0]) to the global @pdeps, if it's not already there, and
#	if it doesn't match the package name ($_[1])
#
sub add2pdeps {
	if($_[0] eq $_[1]) { return; }
	my $item;
	foreach $item (@pdeps) {
		if($item eq $_[0]) { return; }
	}
	push(@pdeps,$_[0]);
}


#
#	Declaration of globals, setting them to their defaults
#
my $hasv = 1;	# do package names include version numbers?
my $outdir = '';
my $debug = 0;

#
#	Start of program proper
#
#if($#ARGV == -1) {
#	usage();
#	exit;
#}

for( $i = 0; $i <= $#ARGV; $i++ ) {

	if($ARGV[$i] eq '-p') {
		#	add the following arg to @packages
		if($#ARGV == $i++) {
			usage();
			exit;
		}
		push(packages,$ARGV[$i]);
		$hasv = 0;

	} elsif($ARGV[$i] eq '-f') {
		# add the packages from the file in $ARGV[$i+1] to @packages
		if($#ARGV == $i++) {
			usage();
			exit;
		}
		if(readlist($ARGV[$i]) == 0) { exit; }
		$hasv = 0;

	} elsif($ARGV[$i] eq '-o') {
		# set the output directory
		if($#ARGV == $i++) {
			usage();
			exit;
		}
		$outdir = $ARGV[$i];

	} elsif($ARGV[$i] eq '-d') {
		$debug = 1;
	}

}

#
#	Check that a directory exists at $outdir, if it was set
#
if($outdir ne '') {
	if($outdir =~ m|/$|) {
		$outdir .= 'dbaudit.txt';
	}
	open(OUT, ">$outdir") || die "Couldn't write to $outdir\n";
}

#
#	Grab the current build version from darwinxref
my $build = `darwinxref currentBuild`;
chomp($build);

#
#	If we haven't got any packages to inspect, get the full packagelist 
#	from darwinxref
#
if(@packages == 0) {
	$result = `darwinxref version '*'`;
	@packages = split(/\n/, $result);
	if(($result eq "") || (@packages == 0)) {
		print "Couldn't get package list from darwinxref. Are you running this in darwinbuild?\n";
		exit;
	}
	undef($result);
	$hasv = 1; # incase it was accidentally changed
}

#
#	Now we begin our grand foreach loop, which may take forever. @results gets
#	a line for each package
#
foreach $package (@packages) {

	#
	#	Set up the package's name and version
	#
	if($hasv == 0) {
		$package = `darwinxref version $package`;
	}

	if($package eq '') { next; } # also catches an originally nil $package?

	$package =~ /(\S+)-([\.\d]+)$/;
	$name = $1;
	$version = $2;

	print "Processing package '$name' (v$version)\n";

	#
	#	This is probably a very bad way of seeing whether a binary root for
	#	a package exists somewhere in the darwinbuild system: tell darwinbuild
	#	to load it...
	#
	$result = `darwinbuild -load $name`;
	if($debug == 1) { print "\t-load $name: $result"; }

	#
	#	...and then check for its receipt
	#
	if(-e "BuildRoot/usr/local/darwinbuild/receipts/$name") {
		if($debug == 1) { print "\treciept for $name exists\n"; }
		#
		#	This returns the full paths of all the executables in the package
		#
		@files = readreceipt("BuildRoot/usr/local/darwinbuild/receipts/$name");

		foreach $file (@files) {
			#
			#	Unresolved dependencies will be stored in @deps
			#
			if(-T $file) {
				$file = hashbang($file);
				if($file ne '') { add2deps($file); }
			} else {
				@libs = otool($file);
				if(@libs != 0) {
					if($debug == 1) { print "\t$file has dependencies on:\n"; }

					foreach $lib (@libs) {
						if($debug == 1) { print "\t\t$lib\n"; }
						#
						#	Check to see if the dependency is local to the package, then
						#	whether we've seen it before
						#
						if(localdep($lib) == 0) { add2deps($lib); } # checks before adding
					}
				}
			}
		} # foreach files

		#
		#	Now we turn these library paths back into package names, calling into
		#	darwinxrefs findFile command, storing the result in @pdeps
		#
		foreach $dep (@deps) {
			#print "$dep\n";
			$result = `darwinxref findFile $dep`; # This could be slower. Work out how.
			if(($result ne '') && ($result =~ /(\S+):/)) { 
				add2pdeps($1, $name); 
			} else {
				add2pdeps($dep, $name);
			}
		}

		$result = join(' ', @pdeps);
		$result = "$name Y $build $version { $result }\n";

		@libs = (); # very important tidy-up
		@files = ();
		@deps = ();
		@pdeps = ();
	} 
	else 
	{
		if($debug == 1) { print "$name doesn't appear to have a root available\n"; }
		$result = "$name N $build\n";
	}

	if($outdir eq '') {
		print $result;
	} else {
		print OUT $result;
	} 

}

#
#	@results is an array with an entry for each of the packages scanned. Either
#	write it out to a result file, or print it to the console, depending.
#
#$results = join($/, @results);
#if($outdir eq '') {
#	print "$results\n";
#} else {
#	print OUT $results;
#	close(OUT);
#}
